home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dskut
/
2m21src.zip
/
2M-INFO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-31
|
37KB
|
835 lines
(*********************************************************************
* *
* 2M-INFO 2.1 - Pequeño programa de información sobre 2M. *
* *
*********************************************************************)
(*$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-*)
uses
Dos, Crt;
const
ID_ESPACIO = 1886; (* límite en las gráficas *)
ID_VELOCIDAD = 4850;
CM_CIRIT = 14; (* colores para la pantalla inicial/final *)
CM_CIRIP = 4;
CM_2M = 10;
CM_2MS = 10;
CM_VERT = 13;
CM_VERF = 6;
CM_VERS = 5;
CM_INFO = 9;
CM_PAUSA = 11;
CC_RECUERDO = 12;
CC_DIR = 14;
CE_BARRADOST = 11; (* colores para la grafica de capacidad *)
CE_BARRADOSP = 1;
CE_BARRA2MT = 14;
CE_BARRA2MP = 4;
CE_INDICE = 13;
CE_TITULOT = 11;
CE_TITULOP = 1;
CE_NOTA = 14;
CE_BASECOL = 15;
CE_LEYENDAS = 10;
CV_BARRADOST = 3; (* colores para la grafica de velocidad *)
CV_BARRADOSP = 1;
CV_BARRA2MT = 12;
CV_BARRA2MP = 6;
CV_INDICE = 13;
CV_TITULOT = 11;
CV_TITULOP = 5;
CV_NOTA = 14;
CV_BASECOL = 15;
CV_LEYENDAS = 10;
M_FONDO = 1; (* color del menú *)
M_SOMBRA = 3;
M_TINTA = 15;
M_IDIOMA = 11;
M_TBARRA = 0;
M_FBARRA = 7;
R_CABT = 14; (* color para el readme *)
R_CABP = 5;
R_TINTA = 11;
R_PAPEL = 0;
R_DIR = 14;
R_BRILLO = 10;
N_CABT = 14; (* color de las novedades *)
N_CABP = 4;
N_TINTA = 11;
N_PAPEL = 1;
O2_TINTA = 14; (* color de las información de OS/2 *)
O2_PAPEL = 1;
XT_TINTA = 15; (* color de la información de PC/XT *)
XT_PAPEL = 1;
I_2M1 = 15; (* color para la información de registro *)
I_2M2 = 13;
I_FONDO = 0;
I_CIRI = 14;
I_FLECHA = 12;
I_STAR = 15;
I_REG = 11;
I_REGTT = 11;
I_REGTP = 1;
I_CON = 10;
I_CONT = 14;
type
Vram=array [1..4096] of Byte; (* tamaño de la memoria de vídeo *)
Matriz=array [0..3] of array [0..2] of Integer;
var
xPrev,yPrev, (* coordenadas del cursor previas al programa *)
modo:Byte; (* modo de pantalla previo a este programa *)
ScrColor:Vram absolute $b800:0; (* dirección memoria pantalla color *)
ScrMono: Vram absolute $b000:0; (* " " " monocroma *)
pantalla:Vram; (* para preservar memoria de vídeo *)
opcion, (* Opción del menú en curso *)
ultopc: Integer;
idioma: Integer; (* 34 si castellano *)
function ModoPantalla:Byte;
var
r:Registers;
begin
r.ah:=15; intr(16,r); (* función BIOS para averiguar modo de pantalla *)
ModoPantalla:=r.al;
end;
procedure GuardarPantalla;
begin
modo:=ModoPantalla; (* inicializar aquí esta variable global *)
if modo=7 then pantalla:=ScrMono else pantalla:=ScrColor;
xPrev:=whereX; yPrev:=whereY;
if (modo<>2) and (modo<>3) then TextMode(CO80);
end;
procedure ReponerPantalla;
begin
textMode(modo);
window(1,1,80,25); gotoXY(xPrev,yPrev);
if (modo<=3) or (modo=7) then
if ModoPantalla=7 then ScrMono:=pantalla else ScrColor:=pantalla;
end;
procedure CursorOff;
var
r:Registers;
begin
r.dh:=100; r.dl:=0; r.bh:=0; (* coordenadas fuera de pantalla *)
r.ah:=2; intr(16,r) (* servicio del BIOS para localizar el cursor *)
end;
function sp:Boolean;
var
r: Registers;
id: Byte;
datos: array[1..128] of byte;
begin
if idioma<2 then begin (* 0-evaluar, 1-invertir, 2-sp, 3-eng *)
r.ah:=$30; MsDos(r);
if r.al>=3 then begin (* DOS = 3.0 *)
r.ax:=$3800; r.ds:=SEG(datos); r.dx:=OFS(datos); msdos (r);
case r.bx of
54, 591, 57, 506, 56, 593, 503, 34, 63, 502,
504, 212, 52, 505, 507, 595, 51, 80, 508, 598,
58, 3, 0: id:=34;
end
end;
if idioma=0 then if id=34 then idioma:=2 else idioma:=3;
if idioma=1 then if id=34 then idioma:=3 else idioma:=2;
end;
sp:=idioma=2;
end;
procedure Pausa;
var
t:Char;
begin
CursorOff;
t:=readkey; if t=chr(0) then t:=readkey;
end;
procedure PantallaGalactica (logo: Boolean);
var
x: Integer;
procedure escribir (cad: String);
var
i:Integer;
begin
gotoxy (8, WhereY);
for i:=1 to length(cad) do
case cad[i] of
' ': write (' ');
'.', '·': begin TextColor(random(6)+10); write (cad[i]); end;
'▒': if i<35 then
begin TextColor(CM_2M); write ('▒'); end
else
begin TextColor(CM_VERT); TextBackGround(CM_VERF);
write ('▒'); TextBackGround(0); end;
'█', '▄', '▀': if i<35 then
begin TextColor(CM_2MS); write (cad[i]); end
else
begin TextColor(CM_VERS); write (cad[i]); end;
end;
writeLn;
end; (* escribir *)
begin
TextBackGround(0); ClrScr;
RandSeed:=7;
for x:=1 to 79 do begin
gotoXY (x,random(25)); TextColor(random(6)+2); write('.');
gotoXY (x,random(25)); TextColor(random(6)+2); write('·');
gotoXY (x,random(25)); TextColor(random(6)+10); write('.');
gotoXY (x,random(25)); TextColor(random(6)+10); write('·');
gotoXY (x,random(25)); TextColor(random(6)+10); write('·');
end;
if logo=TRUE then begin
gotoxy (1,6);
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄ ▒▒▒▒▄ ▒▒▒▒▄');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ▒▒▒▒▒▄ ▒▒▒▒▒█');
escribir(' ▀▀▀▀▀▀▀▀▀▀▒▒▒▒█. ▒▒▒▒▒▒▄ ▒▒▒▒▒▒█');
escribir(' · . ▒▒▒▒█ ▒▒▒▒▒▒▒▄▒▒▒▒▒▒▒█');
escribir(' · . ▒▒▒▒█ ▒▒▒▒█▒▒▒▒▒█▒▒▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ·▒▒▒▒█ ▒▒▒█▀▒▒▒▒█ . ▒▒▒▒▒▒▒▒▒▒▄ . · .▒▒▄');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ ▒▒▒▒█ ▒█▀ ▒▒▒▒█ ▀▀▀▀▀▀▀▒▒█ ▒▒▒▒█');
escribir('▒▒▒▒█▀▀▀▀▀▀▀▀▀▀▀ ▒▒▒▒█ . ▀ ▒▒▒▒█ . · ▒▒█ · ▒▒▄▀▒▒█');
escribir('▒▒▒▒█ · . · ▒▒▒▒█ · . ▒▒▒▒█ ▒▒▒▒▒▒▒▒▒▒█ . ▀▀ ▒▒█');
escribir('▒▒▒▒█ . · ▒▒▒▒█ · ▒▒▒▒█ · ▒▒█▀▀▀▀▀▀▀▀ . .▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▄ ▒▒▒▒█ .· ▒▒▒▒█ ▒▒█ · . · · ▒▒█');
escribir('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█ .▒▒▒▒█ · ▒▒▒▒█ . ▒▒▒▒▒▒▒▒▒▒▄ ▒▒▄ ▒▒▒▒▒▒▒▒▒▒▄');
escribir(' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ▀▀▀▀ · . ▀▀▀▀ · ▀▀▀▀▀▀▀▀▀▀ ▀▀ ▀▀▀▀▀▀▀▀▀▀');
CursorOff;
end;
end;
procedure Presentacion;
begin
gotoxy(10,3); TextColor (CM_CIRIT); TextBackGround (CM_CIRIP);
write(' C I R I A C O G A R C I A D E C E L I S ');
if sp then write('presenta ') else write('presents ');
gotoxy(6-ord(sp),21); TextColor (CM_INFO); TextBackGround(0);
if sp then
write('El formateador de discos de mayor capacidad y velocidad ... en el mundo')
else
write('The highest capacity formatter of faster diskettes ... over the world');
gotoxy(34-ord(sp)*2,24); TextColor (CM_PAUSA);
if sp then
write('(Pulsa una tecla)')
else
write('(Press any key)');
CursorOff;
end;
procedure menu (var opcion: Integer);
var
i:Integer;
t:Char;
procedure PintaOp (opcion: Integer);
begin
gotoXY (3,opcion+1);
case opcion of
1: if sp then
write(' 1.- COMPARATIVA DE CAPACIDAD DE LOS DISQUETES 2M ')
else
write(' 1.- STORAGE COMPARISON BETWEEN 2M AND DOS FORMAT ');
2: if sp then
write(' 2.- COMPARATIVA DE VELOCIDAD DE LOS DISQUETES 2M ')
else
write(' 2.- SPEED COMPARISON BETWEEN 2M AND DOS FORMAT ');
3: if sp then
write(' 3.- 2M ES MUY FACIL DE USAR ')